home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / cmds / scvs / scvs.test < prev    next >
Text File  |  1991-10-31  |  51KB  |  2,201 lines
  1. #! /sprite/cmds/perl 
  2. #
  3. #   Scvs is the "Sprite Concurrent Version System", pronounced "skivies".
  4. #   It is a Perl script wrapper for cvs.  See the cvs man page for more
  5. #   details.
  6. #
  7. # $Header: /sprite/src/cmds/scvs/RCS/scvs,v 1.13 91/10/31 13:08:52 jhh Exp Locker: jhh $ SPRITE (Berkeley)
  8. #
  9. # Copyright 1991 Regents of the University of California
  10. # Permission to use, copy, modify, and distribute this
  11. # software and its documentation for any purpose and without
  12. # fee is hereby granted, provided that this copyright
  13. # notice appears in all copies.  The University of California
  14. # makes no representations about the suitability of this
  15. # software for any purpose.  It is provided "as is" without
  16. # express or implied warranty.
  17. #
  18.  
  19. require "option.pl";
  20. require "pwd.pl";
  21. require "ctime.pl";
  22. require "stat.pl";
  23.  
  24. $recurse = 1;
  25. $verbose = 0;
  26. $linkFile = "links";
  27. $debug = 0;
  28. $configFile = "SCVS.config";
  29. $argFile = "args";
  30. $modNameFile = "moduleName";
  31. $userFile = "SCVS/users";
  32.  
  33. @options = (
  34.     $OPT_NIL, $OPT_DOC, $OPT_NIL, 
  35.     "Usage: scvs [scvs options] command [command options]",
  36.     "V", $OPT_TRUE, *verbose, "Verbose",
  37.     "D", $OPT_TRUE, *debug, "Debug",
  38.     "r", $OPT_FUNC, "CvsOpt1", "Check out files read-only",
  39.     "w", $OPT_FUNC, "CvsOpt1", "Check out files read-write (default)",
  40.     "v", $OPT_FUNC, "CvsOpt1", "Print cvs version info",
  41.     "d", $OPT_STRING, *cvsroot, "Specify cvs root directory",
  42.     "e", $OPT_FUNC, "CvsOpt1", "Specify editor to use",
  43.     "H", $OPT_FUNC, "CvsOpt1", "Print help information",
  44. );
  45. undef($cvsargs);
  46. &Opt_Parse(*ARGV, @options, $OPT_OPTIONS_FIRST);
  47. if ($debug) {
  48.     $verbose = 1;
  49. }
  50. $cvsCmdArgs = $cvsargs;
  51.  
  52. @cvsCmds = ("join", "patch", "tag");
  53.  
  54.  
  55. #
  56. # Config
  57. #
  58. # Find the configuration file and set up various configuration variables.
  59. #
  60. # Results: 0 if successful, 1 otherwise
  61. # 
  62. # Side effects: Some variables are set.
  63. #
  64.  
  65. sub Config {
  66.     local($pwd) = $ENV{'PWD'};
  67.     local($stat, $lastStat) = (0, 0);
  68.     local($tmp);
  69.     local(@attempts);
  70.  
  71.     #
  72.     # Work our way up the directory tree looking for the config file.
  73.     #
  74.     while(! -e $configFile) {
  75.     push(@attempts, $ENV{'PWD'});
  76.     &Chdir("..") == 0 || return 1;
  77.     &Stat(".");
  78.     $stat = $st_dev . $st_ino . $st_serverID;
  79.     last if ($stat eq $lastStat);
  80.     $lastStat = $stat;
  81.     }
  82.     if (! -e $configFile) {
  83.     printf("Couldn't find configuration file\n");
  84.     foreach $tmp (@attempts) {
  85.         printf("Not in $tmp\n");
  86.     }
  87.     return 1;
  88.     }
  89.     open(CONFIG, "$configFile") || die("Can't open $configFile: $!\n");
  90.     while(<CONFIG>) {
  91.     next if (/^\s*#/);
  92.     if (/^cvsroot:\s+(\S+)\s*$/) {
  93.         if (!defined($cvsroot)) {
  94.         $cvsroot = $1;
  95.         }
  96.     } elsif(/^installdir:\s+(\S+)\s*$/) {
  97.         $installdir = $1;
  98.     }
  99.     }
  100.     close(CONFIG);
  101.     if (!defined($cvsroot)) {
  102.     printf("cvsroot not set in config file\n");
  103.     return 1;
  104.     }
  105.     &Chdir("$pwd") == 0 || return 1;
  106.     return 0;
  107. }
  108.  
  109. #
  110. # PackCmd($command, @dirs)
  111. #
  112. # Runs a Pack or Unpack command on each of the directories in the list.
  113. #
  114. # Results: 0 if successful, 1 otherwise
  115. #
  116. # Side effects:  The link file is modified.
  117. #
  118.  
  119. sub PackCmd {
  120.     local($command) = shift;
  121.     local(@dirs) = @_;
  122.     local($status) = 0;
  123.     local($pwd) = $ENV{'PWD'};
  124.  
  125.     if ($#dirs < $[) {
  126.     push(@dirs, '.');
  127.     }
  128.     foreach $dir (@dirs) {
  129.     &Chdir($dir) == 0 || return 1; 
  130.     if ($command eq "pack") {
  131.         $status = &Pack($dir);
  132.     } else {
  133.         $status = &Unpack($dir);
  134.     }
  135.     if ($status) {
  136.         return $status;
  137.     }
  138.     &Chdir($pwd) == 0 || return 1; 
  139.     }
  140. }
  141. #
  142. # Pack($path)
  143. #
  144. # Finds all symbolic links in the current directory and puts them in the
  145. # link file.  The links are stored in alphabetical
  146. # order.  If $recurse is non-zero, Pack will call itself to recurse on
  147. # subdirectories.
  148. #
  149. # Results: 0 if successful, 1 otherwise
  150. #
  151. # Side effects: The link file is modified.
  152. #
  153.  
  154. sub Pack {
  155.     local($path) = shift;
  156.     local($addDir) = 0;
  157.     local($addFile) = 0;
  158.     local(%links);
  159.     local($link);
  160.  
  161.     #
  162.     # Don't pack SCVS subdirectories.
  163.     #
  164.     if ($path =~ m|.*/SCVS|) {
  165.     return 0;
  166.     }
  167.     printf(STDERR "Packing $path\n") if ($debug);
  168.     $addDir = (-d "SCVS") ? 0 : 1;
  169.     $addFile = (-f "SCVS/$linkFile") ? 0 : 1;
  170.     opendir(THISDIR, ".") || return &Error(1, "Opendir of $path failed: $!\n");
  171.     foreach $link (grep(-l, readdir(THISDIR))) {
  172.     printf(STDERR "$link\n") if ($debug);
  173.     $links{$link} = readlink($link);
  174.     }
  175.     close(THISDIR);
  176.     if (defined(%links) || (!$addFile)) {
  177.     if ($addDir) {
  178.         mkdir("SCVS", 0770) ||
  179.         return &Error(1, "Mkdir of SCVS failed: $!\n");
  180.     }
  181.     if (open(PACK, ">SCVS/$linkFile") == 0) {
  182.         printf("Can't open $linkFile: $!\n");
  183.         $status = 1;
  184.         last;
  185.     }
  186.     printf(PACK 
  187.         "# This file is used by scvs and contains symbolic link\n");
  188.     printf(PACK 
  189.         "# information.  Each line is of the form \"link target\"\n");
  190.     printf(PACK "# \$Header\n");
  191.     foreach $link (sort keys %links) {
  192.         printf(PACK "%-24s %s\n", $link, $links{$link});
  193.     }
  194.     close(PACK);
  195.     if ($addFile && (-e "CVS.adm")) {
  196.         if ($addDir) {
  197.         system("cvs -d $cvsroot add SCVS");
  198.         }
  199.         system("cvs -d $cvsroot add -m\"scvs links\" SCVS/$linkFile");
  200.     }
  201.     } 
  202.     if ($recurse) {
  203.     $status = &AllSubdirs($path, "Pack");
  204.     }
  205.     return $status;
  206. }
  207.  
  208. #
  209. # Unpack($path)
  210. #
  211. # Reads the link file in the current directory and creates symbolic links
  212. # from its contents. If recurse is non-zero, Unpack will call itself to 
  213. # recurse on subdirectories.
  214. #
  215. # Results: 0 if successful, 1 otherwise
  216. #
  217. # Side effects: Symbolic links may be created in the current directory
  218. #
  219. sub Unpack {
  220.     local($path) = shift;
  221.     local($status) = 0;
  222.  
  223.     printf(STDERR "Unpacking $path\n") if ($debug);
  224.     if (open(UNPACK, "SCVS/$linkFile")) {
  225.     while(<UNPACK>) {
  226.         next if (/^#/);
  227.         if (/(\S+)\s+(\S+)/) {
  228.         ($link, $value) = ($1, $2);
  229.         if (-l $link) {
  230.             $old = readlink($link);
  231.             if ($old ne $value) {
  232.             printf(
  233.             "Changing $link -> $value, instead of -> $old\n");
  234.             unlink($link);
  235.             } else {
  236.             next;
  237.             }
  238.         } elsif (-e $link) {
  239.             printf("File $link already exists.\n");
  240.             $status = 1;
  241.             next;
  242.         } elsif ($verbose) {
  243.             printf("Creating: $link -> $value\n");
  244.         }
  245.         if (symlink($value, $link) == 0) { 
  246.             printf("Can't create link from $link to $value: $!");
  247.             $status = 1;
  248.         }
  249.         }
  250.     }
  251.     close(UNPACK);
  252.     }
  253.     if ($recurse) {
  254.     $status = &AllSubdirs($path, "Unpack");
  255.     }
  256.     return $status;
  257. }
  258.  
  259. #
  260. # Repository(module)
  261. #
  262. # Finds the pathname of the repository directory for the given module.
  263. #
  264. # Results: The pathname
  265. #
  266. # Side effects: 
  267. #
  268.  
  269. sub Repository {
  270.     local($tmp);
  271.     $tmp = &ReadFile("$_[0]/CVS.adm/Repository", 1);
  272.     if (defined($tmp)) {
  273.     chop($tmp);
  274.     return "$cvsroot/$tmp"; 
  275.     }
  276.     return undef;
  277. }
  278.  
  279. #
  280. # Prune($path)
  281. #
  282. # Removes the given directory if it is empty (no user files or subdirectories).
  283. # Recurses on subdirectories.
  284. #
  285. # Results: 0 if successful, 1 otherwise
  286. #
  287. # Side effects: The directory or its subdirectories may be removed.
  288. #
  289.  
  290. sub Prune {
  291.     local($path) = shift;
  292.     local($i);
  293.     local($status) = 0;
  294.     local($empty) = 1;
  295.     local($tail) = substr($path, rindex($path, '/') + 1);
  296.  
  297.     if ($tail eq "SCVS") {
  298.     return 0;
  299.     }
  300.     print "Pruning $path\n" if ($debug);
  301.     $status = &AllSubdirs($path, "Prune");
  302.     if ($status) {
  303.     return $status;
  304.     }
  305.     opendir(THISDIR, ".") || 
  306.     return &Error(1, "Opendir of $path failed: $!\n"); 
  307.     foreach $i (readdir(THISDIR)) {
  308.     next if ($i eq ".");
  309.     next if ($i eq "..");
  310.     next if ($i eq "CVS.adm");
  311.     next if ($i eq "SCVS");
  312.     print "Found $i in $path\n" if ($debug);
  313.     $empty = 0;
  314.     last;
  315.     }
  316.     close(THISDIR);
  317.     if ($empty) {
  318.     print "Prune: chdir to ..\n" if ($debug);
  319.     &Chdir("..") == 0 || return 1;
  320.     print "Prune: deleting $tail\n" if ($debug);
  321.     system("rm -rf $tail");
  322.     }
  323.     return 0;
  324. }
  325.  
  326. #
  327. # CvsOpt1($optString, $nextArg)
  328. #
  329. # Appends $optString to $cvsargs.
  330. #
  331. # Results: 0 
  332. #
  333. # Side effects: None
  334. #
  335. sub CvsOpt1 {
  336.     printf("CvsOpt1 @_\n") if ($debug);
  337.     $cvsargs .= "$_[0] ";
  338.     return 0;
  339. }
  340.  
  341. #
  342. # CvsOpt2($optString, $nextArg)
  343. #
  344. # Appends $optString and $nextArg to $cvsargs.
  345. #
  346. # Results: 1
  347. #
  348. # Side effects: None
  349. #
  350. sub CvsOpt2 {
  351.     printf("CvsOpt2 @_\n") if ($debug);
  352.     $cvsargs .= "$_[0] \"$_[1]\" ";
  353.     return 1;
  354. }
  355.  
  356.  
  357. #
  358. # Checkout(@modules)
  359. #
  360. # Checks out modules.  "cvs co" is used to make a copy of the module. 
  361. # Unpack is used to unpack symbolic links.  
  362. # The current user name is added to the SCVS.users
  363. # file and a list of any other users with a copy of the module are 
  364. # printed.  Any options passed to "cvs co" are stored in the SCVS/args
  365. # file to be used on subsequent updates.
  366. #
  367. # Results: 0 if successful, 1 otherwise
  368. #
  369. # Side effects: A subdirectory is created for each module.
  370. #
  371.  
  372. sub Checkout {
  373.     local(@modules) = @_;
  374.     local($buffer, $i,$repos, $user, $date, %count, %dates);
  375.     local($found, $name);
  376.     local($prune) = 1;
  377.     local($personal) = 0;
  378.     local($args);
  379.     local(@options) = ( 
  380.     "l", $OPT_FALSE, *recurse, "Don't recurse.",
  381.     "P", $OPT_FALSE, *prune, "Don't prune empty directories.",
  382.     "i", $OPT_TRUE, *personal, "Deviation from standard source tree",
  383.     "f", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  384.     "c", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  385.     "Q", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  386.     "q", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  387.     "f", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  388.     "n", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  389.     "p", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  390.     "r", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  391.     "D", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  392.      );
  393.  
  394.     undef($cvsargs);
  395.     &Opt_Parse(*modules, @options, $OPT_OPTIONS_FIRST | $OPT_NO_SPACE);
  396.     $args = $cvsargs;
  397.  
  398.     # Put together the "cvs co" command.
  399.  
  400.     $buffer = "cvs -d $cvsroot $cvsCmdArgs co $args";
  401.  
  402.     if ($args =~ /-c/) {
  403.     system("$buffer");
  404.     return 0;
  405.     }
  406.    if (($args =~ /-r/) || ($args =~ /-D/)) {
  407.     $buffer .= "-f ";
  408.     }
  409.     $status = &Lock("r", @modules);
  410.     if ($status) {
  411.     return $status;
  412.     }
  413.     $user = getlogin;
  414.     print "@modules\n" if ($debug);
  415.  
  416. module:
  417.     foreach $i (@modules) {
  418.     local($pwd) = $ENV{'PWD'};
  419.  
  420.     printf("Checking out $i\n") if ($debug);
  421.     # Perform the "cvs co".
  422.  
  423.     printf("$buffer $i \n") if ($debug);
  424.     system("$buffer $i");
  425.  
  426.     # Store the "cvs co" arguments in the info file.
  427.  
  428.     if (! -d "$i/SCVS") {
  429.         if (!mkdir("$i/SCVS", 0770)) {
  430.         $status = &Error(1, "Mkdir of $i/SCVS failed: $!\n");
  431.         next module;
  432.         }
  433.     }
  434.     if (!open(CO, ">$i/SCVS/$argFile")) {
  435.         $status = &Error(1, "Open of $i/SCVS/$argFile failed: $!\n");
  436.         next module;
  437.     }
  438.     print(CO "# This file contains the arguments given when this\n");
  439.     print(CO "# module was checked out.\n");
  440.     print(CO "$cvsCmdArgs\n");
  441.     print(CO "$args\n");
  442.     close(CO);
  443.  
  444.     &Chdir($i) == 0 || return 1; 
  445.  
  446.     # Unpack the module.
  447.     &Unpack($i) == 0 || return &Error("Unpack of $i failed\n");
  448.  
  449.     # Prune any empty directories in the module.
  450.     if ($prune) {
  451.         &Prune($i) == 0 || return &Error(1, "Prune of $i failed\n");
  452.     }
  453.  
  454.     &Chdir($pwd) == 0 || return 1; 
  455.  
  456.     # See if any other users have a copy of the module, and add our
  457.     # own entry.
  458.  
  459.     $repos = &Repository($i);
  460.     next module if (!defined($repos));
  461.     $date = &ctime(time);
  462.     open(CO2, ">$repos/$tmpfile") ||
  463.         return &Error(1, "Open of $repos/$tmpfile failed: $!\n");
  464.     if (-e "$repos/$userFile") {
  465.         local($copy) = 0;
  466.         open(CO1, "$repos/$userFile") ||
  467.         return &Error(1, "Open of $repos/$userFile failed: $!\n");
  468.         while(<CO1>) {
  469.         $copy = 0;
  470.         next if (/^#/);
  471.         if (/^$user\s+([\w\/\.]+)\s+(.*)/) {
  472.             if ($1 eq "$pwd/$i") {
  473.             $copy = 1;
  474.             } else {
  475.             $found = 1;
  476.             push(@mine, $_);
  477.             }
  478.         } elsif (/^(\S+)\s+([\w\/\.]+)\s+(.*)/) {
  479.             $others{$1} = $3;
  480.         }
  481.         }
  482.         continue {
  483.         if (!$copy) {
  484.             print CO2 $_;
  485.         }
  486.         }
  487.         close(CO1);
  488.     } else {
  489.         printf(CO2 "# List of users with copies of this module.\n");
  490.     }
  491.     if ($#mine >= $[) {
  492.         printf("\nYou also have these copies of the $i module:\n");
  493.         print join("\n", @mine);
  494.     }
  495.     printf(CO2 "$user $pwd/$i %s", &ctime(time));
  496.     close(CO2);
  497.     if (!$personal) {
  498.         if (!rename("$repos/$tmpfile", "$repos/$userFile")) {
  499.         printf(
  500.           "Rename of $repos/$tmpfile to $repos/$userFile failed:$!\n");
  501.         unlink("$repos/$tmpfile");
  502.         next module;
  503.         }
  504.     } else {
  505.         unlink("$repos/$tmpfile");
  506.     }
  507.     if (defined(%others)) {
  508.         printf("\nThe following users have copies of the $i module:\n"); 
  509.         while(($name, $date) = each(%others)) {
  510.         printf("$name $date\n");
  511.         }
  512.     }
  513.     }
  514.     return 0;
  515. }
  516.  
  517. #
  518. # UnlockCmd(@ARGV)
  519. #
  520. # Parse arguements, then call Unlock to do the dirty work. 
  521. #
  522. # Results: 0 if successful, 1 otherwise
  523. #
  524. # Side effects: 
  525. #
  526. sub UnlockCmd {
  527.     local(@args) = @_;
  528.     local($all) = 0;
  529.     local($status) = 0;
  530.     local(@options) = (
  531.     "a", $OPT_TRUE, *all, "Remove everybody's locks",
  532.     );
  533.     &Opt_Parse(*args, @options, $OPT_OPTIONS_FIRST);
  534.     $status = &Unlock($all,@args);
  535.     return $status;
  536. }
  537.  
  538.  
  539. #
  540. # Unlock($allusers, @modules)
  541. #
  542. # Remove the locks for a list of modules.  
  543. #
  544. # Results: 0 if successful, 1 otherwise
  545. #
  546. # Side effects: 
  547. #
  548.  
  549. sub Unlock {
  550.     local($allusers) = shift;
  551.     local(@modules) = @_;
  552.     local($cvsdir, $i, $lock);
  553.     local($status) = 0;
  554.     local($user) = getlogin;
  555.  
  556.     print("Unlock $allusers @modules\n") if ($debug);
  557.     if (!defined(%modMap)) {
  558.     &ModMap;
  559.     }
  560.     if ($#modules < $[) {
  561.     push(@modules, ".");
  562.     }
  563. module:
  564.     foreach $i (@modules) {
  565.     if ($i eq ".") {
  566.         $i = &GetModuleName;
  567.         if (!defined($i)) {
  568.         $status = 1;
  569.         next module;
  570.         }
  571.     }
  572.     if (!defined($modMap{$i})) {
  573.         printf(STDERR "Module $i does not exist.\n");
  574.         $status = 1;
  575.         next module;
  576.     }
  577.     $cvsdir = "$cvsroot/$modMap{$i}/SCVS";
  578.     $lock = "$cvsdir/locks";
  579.     if (!-e $lock) {
  580.         next module;
  581.     }
  582.     if ($allusers) {
  583.         if (!unlink($lock)) {
  584.         printf("Can't remove lock file $lock: $!\n");
  585.         }
  586.         next module;
  587.     }
  588.     if (!open(UNLOCK1, "$lock")) {
  589.         print("Open of $lock failed: $!\n");
  590.         next module;
  591.     }
  592.     if (!open(UNLOCK2, ">$cvsdir/$tmpfile")) {
  593.         print("Open of $cvsdir/$tmpfile failed: $!\n");
  594.         next module;
  595.     }
  596.     flock(UNLOCK1, 2) || 
  597.         return &Error(1, "Flock(2) of $lock failed: $!\n");
  598.  
  599.     while(<UNLOCK1>) {
  600.         ($type, $name) = split(' ');
  601.         if ($name ne $user) {
  602.         print(UNLOCK2 $_);
  603.         }
  604.     }
  605.     close(UNLOCK2);
  606.     if (!rename("$cvsdir/$tmpfile", "$lock")) {
  607.         printf(
  608.           "Rename of $cvsdir/$tmpfile to $lock failed:$!\n");
  609.         unlink("$cvsdir/$tmpfile");
  610.         next module;
  611.     }
  612.     }
  613.     return $status;
  614. }
  615.  
  616. #
  617. # LockCmd(@ARGV)
  618. #
  619. # Parse any options then call Lock to do all the work.
  620. #
  621. # Results: 0 if successful, 1 otherwise
  622. #
  623. # Side effects: The lock files in the modules are updated.
  624. #
  625.  
  626. sub LockCmd {
  627.     local(@args) = @_;
  628.     local($write) = 1;
  629.     local($status) = 0;
  630.     local(@options) = (
  631.     "w", $OPT_TRUE, *write, "Write (exclusive) lock",
  632.     "r", $OPT_FALSE, *write, "Read (shared) lock",
  633.     );
  634.     print("LockCmd @args\n") if ($debug);
  635.     &Opt_Parse(*args, @options, $OPT_OPTIONS_FIRST);
  636.     $status = &Lock($write ? "w" : "r", @args);
  637.     undef(@locks);
  638.     return $status;
  639. }
  640.  
  641.  
  642. #
  643. # Lock($type, @modules)
  644. #
  645. # Make sure the modules are unlocked, and lock them.  Any modules that
  646. # we lock are put in the @lock array.  
  647. #
  648. # Results: 0 if successful, 1 otherwise
  649. #
  650. # Side effects: Lock files are created in the modules.
  651. #
  652.  
  653. sub Lock {
  654.     local($type) = shift;
  655.     local(@modules) = @_;
  656.     local($cvsdir);
  657.     local($status) = 0;
  658.     local($i, $name);
  659.     local(@mylocks);
  660.     local($user) = getlogin;
  661.     local(@lockFiles);
  662.     local($prevType);
  663.     local($prevName);
  664.     local($prevDate);
  665.     local(@prevLocks);
  666.     local($lock);
  667.  
  668.     print("Lock $type @modules\n") if ($debug);
  669.     if (!defined(%modMap)) {
  670.     &ModMap;
  671.     }
  672.     if ($#modules < $[) {
  673.     push(@modules, ".");
  674.     }
  675. module:
  676.     foreach $i (@modules) {
  677.     if ($i eq ".") {
  678.         $i = &GetModuleName;
  679.         if (!defined($i)) {
  680.         $status = 1;
  681.         next module;
  682.         }
  683.     }
  684.     if (!defined($modMap{$i})) {
  685.         printf(STDERR "$i module does not exist.\n");
  686.         $status = 1;
  687.         next module;
  688.     }
  689.     $cvsdir = "$cvsroot/$modMap{$i}/SCVS";
  690.     $lock = "$cvsdir/locks";
  691.     print("Cvsdir = $cvsdir\n") if ($debug);
  692.     if (-f "$lock") {
  693.         print("Opening $lock\n") if ($debug);
  694.         open(LOCK1, "$lock") || 
  695.         return &Error(1, "Open of $lock failed: $!\n");
  696.         flock(LOCK1, 2) || 
  697.         return &Error(1, "Flock(2) of $lock failed: $!\n");
  698.         while(<LOCK1>) {
  699.         ($prevType, $prevName) = split(' ');
  700.         if ($prevName eq $user) {
  701.             if ($prevType ne $type) {
  702.             return &Error(1, "$i already locked:\n$_");
  703.             } else {
  704.             close(LOCK1);
  705.             next module;
  706.             }
  707.         } else {
  708.             if (($prevType eq "r") && ($type eq "w")) {
  709.             return &Error(1, "$i already locked:\n$_");
  710.             } elsif ($prevType eq "w") {
  711.             return &Error(1, "$i already locked:\n$_");
  712.             }
  713.         }
  714.         push(@prevLocks, $_);
  715.         }
  716.     }
  717.     open(LOCK2, ">$cvsdir/$tmpfile") ||
  718.         return &Error(1, "Open of $cvsdir/$tmpfile failed: $!\n");
  719.     foreach $i (@prevLocks) {
  720.         print(LOCK2 "$i");
  721.     }
  722.     printf(LOCK2 "$type $user %s", &ctime(time));
  723.     close(LOCK2);
  724.     if (!rename("$cvsdir/$tmpfile", "$lock")) {
  725.         printf(
  726.           "Rename of $cvsdir/$tmpfile to $lock failed:$!\n");
  727.         unlink("$cvsdir/$tmpfile");
  728.         return 1;
  729.     }
  730.     push(@mylocks, $i);
  731.     close(LOCK1);
  732.     }
  733.     if ($status) {
  734.     if (&Unlock(0, @mylocks)) {
  735.         return &Error(1, "Can't clean up in LockCmd\n");
  736.     }
  737.     }
  738.     push(@locks, @mylocks);
  739.     return $status;
  740. }
  741.  
  742. #
  743. # UpdateCmd($lock, @names)
  744. #
  745. # Update modules.  If the arguments are a list of subdirectories then
  746. # we chdir to each of them and run "cvs update".  If the arguments are
  747. # a list of files then we pass them to cvs.  If no files or directories
  748. # are specified then we update the current directory.  The arguments
  749. # for update are retrieved from the SCVS/args file.
  750. #
  751. # Results: 0 if successful, 1 otherwise
  752. #
  753. # Side effects: 
  754. #
  755.  
  756. sub UpdateCmd {
  757.     local($lock) = shift;
  758.     local(@names) = @_;
  759.     local($buffer, $i, $cvsdir, $date, %count, %dates);
  760.     local($found, $name);
  761.     local($module);
  762.     local($pwd);
  763.     local($tmp);
  764.     local($prune);
  765.     local($buildDirs) = 1;
  766.     local($args);
  767.     local(@options) = ( 
  768.     "B", $OPT_FALSE, *buildDirs, "Don't create new directories.",
  769.     "l", $OPT_FALSE, *recurse, "Don't recurse on subdirs",
  770.     "Q", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  771.     "q", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  772.     "f", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  773.     "n", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  774.     "p", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  775.     "d", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  776.     "r", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  777.     "D", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  778.     );
  779.     undef($cvsargs);
  780.     &Opt_Parse(*names, @options, $OPT_OPTIONS_FIRST | $OPT_NO_SPACE);
  781.     $args = $cvsargs;
  782.  
  783.     # Put together the "cvs update" command.
  784.  
  785.     if ($buildDirs) {
  786.     $args .= "-d ";
  787.     }
  788.     if (! $recurse) {
  789.     $args .= "-l ";
  790.     }
  791.     $buffer = "cvs -d $cvsroot $cvsCmdArgs ";
  792.  
  793.     if ($#names < $[) {
  794.     push(@names, ".");
  795.     }
  796.     if (! -d $names[0]) {
  797.     if ($lock) {
  798.         $status = &Lock("r","."); 
  799.         if ($status) {
  800.         return $status;
  801.         }
  802.     }
  803.     $tmp = "$buffer update $args @names";
  804.     printf("$tmp\n") if ($debug);
  805.     system($tmp);
  806.     $recurse = 0;
  807.     &Unpack(".") == 0 ||
  808.         return &Error(1, "Unpack of current directory failed.\n");
  809.     } else {
  810.     #
  811.     # Lock the modules.
  812.     #
  813.     if ($lock) {
  814.         $status = &Lock("r", @names); 
  815.         if ($status) {
  816.         return $status;
  817.         }
  818.     }
  819.     $pwd = $ENV{'PWD'};
  820. module: 
  821.     foreach $i (@names) {
  822.         $prune = 0;
  823.         &Chdir($i) == 0 || return 1; 
  824.         if (-e "SCVS/$argFile") {
  825.         local(@targs);
  826.         @targs = &ReadFile("SCVS/$argFile", 1);
  827.         if ($targs[1] =~ /(.*)-p(.*)/) {
  828.             $targs[1] = "$1 $2";
  829.             $prune = 1;
  830.         }
  831.         chop($targs[0]);
  832.         chop($targs[1]);
  833.         $tmp = "$buffer $targs[0] update $args $targs[1]";
  834.         printf("$tmp\n") if ($debug);
  835.         }
  836.         system($tmp);
  837.         if (&Unpack($i)) {
  838.         printf(STDERR "Unpack of $i failed.\n");
  839.         $status = 1;
  840.         }
  841.         if ($prune) {
  842.         if (&Prune($i)) {
  843.             printf(STDERR "Prune of $i failed.\n");
  844.             $status = 1;
  845.         }
  846.         }
  847.  
  848.         &Chdir($pwd) == 0 || return 1; 
  849.     }
  850.     }
  851.     return $status;
  852. }
  853.  
  854. #
  855. # Changed($path)
  856. #
  857. # Use the "cvs info" command to see if the contents of the current directory
  858. # or its subdirectories have been changed by the user.  The modified
  859. # parameter is set to 1 if they have been.
  860. #
  861. # Results: 0 if successful, 1 otherwise; 0 if not modified, 1 otherwise
  862. #
  863. # Side effects: 
  864. #
  865. sub Changed {
  866.     local($path) = shift;
  867.     local($modified) = 0;
  868.     local($status) = 0;
  869.     if (!-d "CVS.adm") {
  870.     return 0;
  871.     }
  872.     open(CHG, "cvs -d $cvsroot info |") ||
  873.     return &Error(1, "Can't do cvs info on $path: $!\n");
  874.     while (<CHG>) {
  875.     if (/^[MC]\s+(\S+)/) {
  876.         printf("$path/$1 has been modified\n");
  877.         $modified = 1;
  878.     } elsif(/^A\s+(\S+)/) {
  879.         printf("$path/$1 has been added\n");
  880.         $modified = 1;
  881.     } elsif(/^R\s+(\S+)/) {
  882.         printf("$path/$1 has been deleted\n");
  883.         $modified = 1;
  884.     }
  885.     }
  886.     close(CHG);
  887.     ($status, @results) = &AllSubdirs($path, "Changed");
  888.     if ($status) {
  889.     return $status;
  890.     }
  891.     while ($#results >= $[) {
  892.     local($substatus) = shift(@results);
  893.     local($submod) = shift(@results);
  894.     if ($substatus) {
  895.         $status = 1;
  896.     }
  897.     if ($submod) {
  898.         $modified = 1;
  899.     }
  900.     }
  901.     return ($status, $modified);
  902. }
  903.  
  904. #
  905. # DoneCmd(@modules)
  906. #
  907. # Process the "done" command.  The user is deleted from the list of users
  908. # for each module.  If the -d flag is specified then the snapshot is
  909. # deleted as well.  If the user has made changes to the snapshot the user
  910. # is warned before the "done" command is completed.
  911. #
  912. # Results: 0 if successful, 1 otherwise
  913. #
  914. # Side effects: 
  915. #
  916. sub DoneCmd {
  917.     local(@modules) = @_;
  918.     local($status) = 0;
  919.     local($i);
  920.     local($me) = getlogin;
  921.     local($pwd) = $ENV{'PWD'};
  922.     local($repos, $found);
  923.     local($delete);
  924.     local($modified);
  925.     local(@options) = (
  926.     "d", $OPT_TRUE, *delete, "Delete module",
  927.     );
  928.  
  929.     $recurse = 1;
  930.     undef($cvsargs);
  931.     &Opt_Parse(*modules, @options, $OPT_OPTIONS_FIRST); 
  932.     if ($#modules < $[) {
  933.     return &Error(1, "Done command requires a list of modules\n");
  934.     }
  935.     # Make sure all the modules are unlocked, then lock them.
  936.     $status = &Lock("r",@modules); 
  937.     if ($status) {
  938.     return $status;
  939.     }
  940. module:
  941.     foreach $i (@modules) {
  942.     $ok = 0;
  943.     if (! -d $i) {
  944.         printf("Directory $i not found.\n");
  945.         next module;
  946.     }
  947.     &Chdir($i) == 0 || return 1; 
  948.     ($status, $modified) = &Changed($i);
  949.     if ($status) {
  950.         printf(STDERR "Unable to determine if $i module has changed.\n");
  951.         $modified = 1;
  952.     }
  953.     if ($modified == 1) {
  954.         printf("Do you wish to continue? [y/n] ");
  955. prompt:
  956.         while(1) {
  957.         $answer = <STDIN>;
  958.         chop($answer);
  959.         last prompt if ($answer eq "y");
  960.         next module if ($answer eq "n");
  961.         printf("Please answer with \"y\" or \"n\": ");
  962.         }
  963.     } elsif ($modified == 1) {
  964.         next module;
  965.     }
  966.  
  967.     # Update the user file.
  968.     $repos = &Repository(".");
  969.     next module if (!defined($repos));
  970.     if (!open(DONE1, "$repos/$userFile")) {
  971.         printf("Module $i is not checked out\n");
  972.         next module;
  973.     }
  974.     if (!open(DONE2, ">$repos/$tmpfile")) {
  975.         printf("Can't open $repos/$tmpfile: $!\n");
  976.         $status = 1;
  977.         next module;
  978.     }
  979.     $me = getlogin;
  980.     $found = 0;
  981.     while (<DONE1>) {
  982.         if (/^$me\s+([\w\/\.]+)\s+(.*)/) {
  983.         if ($1 eq "$pwd/$i") {
  984.             $found = 1;
  985.             next;
  986.         }
  987.         }
  988.         print DONE2 $_;
  989.     }
  990.     close(DONE1);
  991.     close(DONE2);
  992.     if (!$found) {
  993.         printf("Module $i is not checked out\n");
  994.         next module;
  995.     }
  996.     if (!rename("$repos/$tmpfile", "$repos/$userFile")) {
  997.         printf("Rename of $repos/$tmpfile to $repos/$userFile failed:$!\n");
  998.         unlink("$repos/$tmpfile");
  999.         next module;
  1000.     }
  1001.     $ok = 1;
  1002.     }
  1003.     continue {
  1004.     &Chdir($pwd) == 0 || return 1; 
  1005.     if ($ok && $delete) {
  1006.         system("rm -rf $i");
  1007.         if ($?) {
  1008.         printf("Delete of $i failed: $?\n");
  1009.         }
  1010.     }
  1011.     }
  1012.     return $status;
  1013. }
  1014.  
  1015. #
  1016. # AllSubdirs(path, routine, args)
  1017. #
  1018. # Call a routine for each subdirectory of the current directory. The
  1019. # current working directory is changed to the subdirectory before the 
  1020. # routine is called, and the path is modified to reflect this change.
  1021. # The path is passed to the routine when it is called. The routine is
  1022. # called for all subdirectories even if one returns an non-zero status,
  1023. # although this function will then return a non-zero status.
  1024. # Any additional arguments for the routine are passed after the path
  1025. # argument.
  1026. #
  1027. # Results: 0 if successful, 1 if the routine returned non-zero for any
  1028. #         of the subdirectories.
  1029. #
  1030. # Side effects: 
  1031. #
  1032. sub AllSubdirs {
  1033.     local($path) = shift;
  1034.     local($routine) = shift;
  1035.     local($pwd) = $ENV{'PWD'};
  1036.     local($substatus);
  1037.     local($dir);
  1038.     local(@results);
  1039.     local(@status);
  1040.     local(@subdirs);
  1041.  
  1042.     printf(STDERR "AllSubdirs of $routine on $pwd\n") if ($debug);
  1043.     opendir(THISDIR, ".") || 
  1044.     return &Error(1, "Opendir of $path failed: $!\n"); 
  1045.     @subdirs = grep((-d) && (!/^\./) && (! -l) && ($_ ne 'CVS.adm'), 
  1046.             readdir(THISDIR));
  1047.     print("AllSubdirs: @subdirs\n") if ($debug);
  1048.     close(THISDIR);
  1049.     print "@subdirs\n****\n" if ($debug); 
  1050.     foreach $dir (@subdirs) {
  1051.     printf("\t$dir\n") if ($debug);
  1052.     &Chdir($dir) == 0 || return 1; 
  1053.     push(@results, &$routine($path . "/$dir", @_));
  1054.     &Chdir($pwd) == 0 || ($status = 1); 
  1055.     }
  1056.     if (wantarray) {
  1057.     return ($status, @results);
  1058.     }
  1059.     if ($status) {
  1060.     return $status;
  1061.     }
  1062.     @status = grep("$_ != 0", @results);
  1063.     if ($#status >= $[) {
  1064.     return $status[0];
  1065.     }
  1066.     return 0;
  1067. }
  1068.  
  1069.  
  1070. #
  1071. # VerifyCurrent($path, *stale, *modified)
  1072. #
  1073. # Check the status of the files in the current directory and its 
  1074. # subdirectories to see if they are out of date.
  1075. #
  1076. # Results: 0 if successful, 1 otherwise;
  1077. #
  1078. # Side effects: 
  1079. #
  1080. sub VerifyCurrent {
  1081.     local($path) = shift;
  1082.     local(*stale) = shift;
  1083.     local(*modified) = shift;
  1084.     local($pwd) = $ENV{'PWD'};
  1085.     local($status) = 0;
  1086.     local($substatus) = 0;
  1087.     local($current) = 1;
  1088.     local($mod) = 0;
  1089.  
  1090.     printf("Verifying that $path is current\n") if ($debug);
  1091.     if (!-d "CVS.adm") {
  1092.     return 0;
  1093.     }
  1094.     open(CHK, "cvs -d $cvsroot info |") ||
  1095.     return &Error(1, "Can't get info for $path: $!\n");
  1096.     while(<CHK>) {
  1097.     if (/^U\s+(\S+)/) {
  1098.         printf("File $path/$1 is out of date or needs to be added.\n");
  1099.         $current = 0;
  1100.     } elsif (/^D\s+(\S+)/) {
  1101.         printf("File $path/$1 has been removed from the repository.\n");
  1102.         $current = 0;
  1103.     } elsif (/^C\s+(\S+)/) {
  1104.         printf("File $path/$1 is out of date.\n");
  1105.         $current = 0;
  1106.     } elsif (/^[MARC]/) {
  1107.         $mod = 1;
  1108.     } 
  1109.     }
  1110.     close(CHK);
  1111.     if (!$current) {
  1112.     printf("$path is not current\n") if ($debug);
  1113.     push(@stale, $path);
  1114.     }
  1115.     if ($mod) {
  1116.     printf("$path has been modified\n") if ($debug);
  1117.     push(@modified, $path);
  1118.     }
  1119.     if ($recurse) {
  1120.     $status = &AllSubdirs($path, "VerifyCurrent", *stale, *modified);
  1121.     }
  1122.     return $status;
  1123. }
  1124.  
  1125. #
  1126. # UpdateInstalled(@files)
  1127. #
  1128. # Update the installed copy of the sources.  This is done on commit.
  1129. # If @files is not specified then the entire directory and its subdirectories
  1130. # are updated.
  1131. #
  1132. # Results: 0 if successful, 1 otherwise
  1133. #
  1134. # Side effects: The installed sources are updated.
  1135. #
  1136. sub UpdateInstalled {
  1137.     local(@files) = @_;
  1138.     local($dir);
  1139.     local($pwd) = $ENV{'PWD'};
  1140.     local($saveArgs) = $cvsCmdArgs;
  1141.  
  1142.     printf(STDERR "UpdateInstalled\n") if ($debug);
  1143.     $cvsCmdArgs = "-r";
  1144.     $dir = &ReadFile("CVS.adm/Repository", 1);
  1145.     if (!defined($dir)) {
  1146.     return 1;
  1147.     }
  1148.     chop($dir);
  1149.     &Chdir("$installdir/$dir") == 0 || return 1;
  1150.     &UpdateCmd(0, "-Q", @files) == 0 || return 1;
  1151.     &Chdir("$pwd") == 0 || return 1;
  1152.     $cvsCmdArgs = $saveArgs;
  1153.     return 0;
  1154. }
  1155.  
  1156.  
  1157.  
  1158. #
  1159. # Commit
  1160. #
  1161. # Commit the current directory and its subdirectories.
  1162. #
  1163. # Results: 0 if successful, 1 otherwise
  1164. #
  1165. # Side effects: 
  1166. #
  1167. sub Commit {
  1168.     local($path) = shift;
  1169.     local($args) = shift;
  1170.     local($pwd) = $ENV{'PWD'};
  1171.     local($status) = 0;
  1172.     local($output);
  1173.     local($tail);
  1174.  
  1175.  
  1176.     printf(STDERR "CommitDir $path\n") if ($debug);
  1177.     if (!-d "CVS.adm") {
  1178.     return 0;
  1179.     }
  1180.     printf("$path:\n");
  1181.     $tail = substr($path, rindex($path, '/') + 1);
  1182.     #
  1183.     # Before we commit the SCVS links file we remove all the deleted links
  1184.     # from it.
  1185.     #
  1186.     if ($tail eq "SCVS") {
  1187.     if (open(CMTDIR1, "$linkFile")) {
  1188.         open(CMTDIR2, ">$tmpfile") ||
  1189.         return &Error(1, "Open of $path/$tmpfile failed: $!\n");
  1190.         while(<CMTDIR1>) {
  1191.         next if (/^[*]/);
  1192.         print CMTDIR2 $_;
  1193.         }
  1194.         close(CMTDIR1);
  1195.         close(CMTDIR2);
  1196.         if (!rename("$tmpfile", "$linkFile")) {
  1197.         printf("Rename of $tmpfile to $linkFile failed:$!\n");
  1198.         unlink("$tmpfile");
  1199.         return 1;
  1200.         }
  1201.         system("cvs -d $cvsroot $cvsCmdArgs ci -f -m scvs links");
  1202.     }
  1203.     }
  1204.     system("cvs -d $cvsroot $cvsCmdArgs ci -f -a $args");
  1205.     return $status;
  1206. }
  1207.  
  1208. #
  1209. # CommitCmd(@names)
  1210. #
  1211. # Commit any changes to the modules or files. 
  1212. # Otherwise all changed files in the current directory and any subdirectories
  1213. # are committed.  Before anything is committed it is checked that all
  1214. # files are up-to-date.  If they aren't, a message is printed and the
  1215. # commit is not done.
  1216. #
  1217. # Results: 0 if successful, 1 otherwise
  1218. #
  1219. # Side effects: 
  1220. #
  1221.  
  1222. sub CommitCmd {
  1223.     local(@names) = @_;
  1224.     local($pwd, $i);
  1225.     local($status) = 0;
  1226.     local($path);
  1227.     local(@stale, @modified);
  1228.     local($tmp);
  1229.     local($args);
  1230.     local(@options) = (
  1231.     "l", $OPT_FALSE, *recurse, "Don't recurse on subdirs",
  1232.     "f", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1233.     "n", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1234.     "m", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  1235.     "r", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  1236.     );
  1237.  
  1238.     $recurse = 1;
  1239.     undef($cvsargs);
  1240.     &Opt_Parse(*names, @options, $OPT_OPTIONS_FIRST | $OPT_NO_SPACE);
  1241.     $args = $cvsargs;
  1242.  
  1243.     if ($#names < $[) {
  1244.     push(@names, ".");
  1245.     }
  1246.     $args .= " -q";
  1247.     if (! -d $names[0]) {
  1248.     $status = &Lock("w","."); 
  1249.     if ($status) {
  1250.         return $status;
  1251.     }
  1252.     $status = &VerifyCurrent(".", *stale, *modified);
  1253.     if ($status) {
  1254.         return $status;
  1255.     }
  1256.     if ($#stale >= $[) {
  1257.         printf("Update your sources using \"scvs update\".\n");
  1258.         return $status;
  1259.     }
  1260.     $tmp = "cvs -d $cvsroot $cvsCmdArgs ci -f $args @names";
  1261.     system($tmp);
  1262.     $status = &UpdateInstalled(@names);
  1263.     } else {
  1264.     $status = &Lock("w",@names); 
  1265.     if ($status) {
  1266.         return $status;
  1267.     }
  1268.     $pwd = $ENV{'PWD'};
  1269.  
  1270.     #
  1271.     # All the modules and their subdirectories must be up-to-date.
  1272.     #
  1273. module:
  1274.     foreach $i (@names) {
  1275.         &Chdir($i) == 0 || return 1; 
  1276.         $status = &VerifyCurrent($i, *stale, *modified);
  1277.         if ($status) {
  1278.         return $status;
  1279.         }
  1280.         &Chdir($pwd) == 0 || return 1; 
  1281.     }
  1282.     
  1283.     if ($#stale >= $[) {
  1284.         printf("Update your sources using \"scvs update\".\n");
  1285.         return $status;
  1286.     }
  1287.     
  1288.     #
  1289.     # Commit all directories that were modified.
  1290.     #
  1291.     foreach $i (@modified) {
  1292.         &Chdir($i) == 0 || return 1; 
  1293.         $status = &Commit($i, $args);
  1294.         last if ($status);
  1295.         if (defined($installdir)) {
  1296.         $status = &UpdateInstalled;
  1297.         last if ($status);
  1298.         }
  1299.         &Chdir($pwd) == 0 || return 1; 
  1300.     }
  1301.     }
  1302.     return $status;
  1303. }
  1304.  
  1305.  
  1306. #
  1307. # WhoCmd(@modules)
  1308. #
  1309. # Print the names of users who have the modules checked out.
  1310. #
  1311. # Results: 0 if successful, 1 otherwise
  1312. #
  1313. # Side effects: 
  1314. #
  1315.  
  1316. sub WhoCmd {
  1317.     local(@modules) = @_;
  1318.     local($pwd, $i);
  1319.     local($status) = 0;
  1320.     local($cvsdir, @who, $user, %users, $line);
  1321.  
  1322.     if (!defined(%modMap)) {
  1323.     &ModMap;
  1324.     }
  1325.     if ($#modules < $[) {
  1326.     push(@modules, ".");
  1327.     }
  1328.     $status = &Lock("r",@modules); 
  1329.     if ($status) {
  1330.     return $status;
  1331.     }
  1332.     $pwd = $ENV{'PWD'};
  1333.  
  1334. module:
  1335.     foreach $i (@modules) {
  1336.     if ($i eq ".") {
  1337.         $i = &GetModuleName;
  1338.         if (!defined($i)) {
  1339.         $status = 1;
  1340.         next module;
  1341.         }
  1342.     }
  1343.     if (!defined($modMap{$i})) {
  1344.         printf(STDERR "$i module does not exist.\n");
  1345.         $status = 1;
  1346.         next module;
  1347.     }
  1348.     $cvsdir = $cvsroot . "/" . $modMap{$i};
  1349.     @who = &ReadFile("$cvsdir/$userFile", 1);
  1350.     foreach $line (@who) {
  1351.         ($user) = split(' ', $line);
  1352.         $users{$user} = 1;
  1353.     }
  1354.     foreach $user (keys %users) {
  1355.         printf("$user\n");
  1356.     }
  1357.     }
  1358.     return $status;
  1359. }
  1360.  
  1361. #
  1362. # AddCmd(@names)
  1363. #
  1364. # Add a file, directory, or symbolic link to a directory.
  1365. #
  1366. # Results: 0 if successful, 1 otherwise
  1367. #
  1368. # Side effects: 
  1369. #
  1370.  
  1371. sub AddCmd {
  1372.     local(@names) = @_;
  1373.     local($i);
  1374.     local($status) = 0;
  1375.     local(%links);
  1376.     local($pwd) = $ENV{'PWD'};
  1377.     local($module);
  1378.     local($args);
  1379.     local(@options) = (
  1380.     "m", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  1381.     );
  1382.  
  1383.     undef($cvsargs);
  1384.     &Opt_Parse(*names, @options, $OPT_OPTIONS_FIRST | $OPT_NO_SPACE);
  1385.     $args = $cvsargs;
  1386.  
  1387.     if ($#names < $[) {
  1388.     return &Error(1, "Add command requires list of files\n");
  1389.     }
  1390.     $module = &GetModuleName;
  1391.     if (!defined($module)) {
  1392.     return 1;
  1393.     }
  1394. name:
  1395.     foreach $i (@names) {
  1396.     if (-l $i) {
  1397.         local($target) = readlink($i);
  1398.         if (!defined($target)) {
  1399.         printf("$i does not exist\n");
  1400.         $status = 1;
  1401.         next name;
  1402.         }
  1403.         if (open(ADD, "SCVS/$linkFile")) {
  1404.         while(<ADD>) {
  1405.             if (/^$i\s+(\S+)/) {
  1406.             if ($target ne $1) {
  1407.                 printf("Link $i already points to $1.\n");
  1408.             } else {
  1409.                 printf("Link $i already added.\n");
  1410.             }
  1411.             $status = 1;
  1412.             close(ADD);
  1413.             next name;
  1414.             }
  1415.         }
  1416.         close(ADD);
  1417.         } elsif (! -f "SCVS/$linkFile") {
  1418.         open(ADD, ">SCVS/$linkFile") ||
  1419.             return &Error(1, "Can't open SCVS/$linkFile: $!\n");
  1420.         printf(ADD 
  1421.         "# This file is used by scvs and contains symbolic link\n");
  1422.         printf(ADD 
  1423.         "# information.  Each line is of the form \"link target\"\n");
  1424.         printf(ADD "# \$Header\n");
  1425.         close(ADD);
  1426.         &Chdir("SCVS") == 0 || return 1; 
  1427.         printf("Adding $linkFile directory\n") if ($debug);
  1428.         system("cvs -d $cvsroot add -m \"sym links\" $linkFile");
  1429.         &Chdir($pwd) == 0 || return 1; 
  1430.         } else {
  1431.         return &Error(1, "Open of SCVS/$linkFile failed: $!\n");
  1432.         }
  1433.         $links{$i} = $target;
  1434.     } else {
  1435.         system("cvs -d $cvsroot $cvsCmdArgs add $args $i");
  1436.         if (-d $i) {
  1437.         # 
  1438.         # If we are adding a directory then we should create an
  1439.         # SCVS subdirectory in it.
  1440.         #
  1441.         if (! -d "$i/SCVS") {
  1442.             mkdir("$i/SCVS", 0770) ||
  1443.             return &Error(1, "Mkdir of $i/SCVS failed: $!\n");
  1444.             &Chdir("$i/SCVS") == 0 || return 1; 
  1445.             open(ADD, ">module") ||
  1446.             return &Error(1, "Open of $i/SCVS/module failed: $!\n");
  1447.             printf(ADD "$module\n");
  1448.             close(ADD);
  1449.             system("cvs -d $cvsroot add module");
  1450.             &Chdir($pwd) == 0 || return 1; 
  1451.         }
  1452.         }
  1453.     }
  1454.     if (defined(%links)) {
  1455.         open(ADD, ">>SCVS/$linkFile") ||
  1456.         return &Error(1, "Open of SCVS/$linkFile failed: $!\n");
  1457.         while (($i, $target) = each(%links)) {
  1458.         printf("Adding link $i -> $target\n") if ($debug);
  1459.         printf(ADD "%-24s %s\n", $i, $target);
  1460.         }
  1461.         close(ADD);
  1462.     }
  1463.     }
  1464.     return $status;
  1465. }
  1466. #
  1467. # RemoveCmd(@names)
  1468. #
  1469. # Removes a file, directory, or symbolic link from a directory.
  1470. #
  1471. # Results: 0 if successful, 1 otherwise
  1472. #
  1473. # Side effects: 
  1474. #
  1475.  
  1476. sub RemoveCmd {
  1477.     local(@names) = @_;
  1478.     local($i);
  1479.     local($status, %links, @delete) = 0;
  1480.  
  1481.     if ($#names < $[) {
  1482.     return &Error(1, "Remove command requires list of files\n");
  1483.     }
  1484.     if (open(RM, "SCVS/$linkFile")) {
  1485.     while(<RM>) {
  1486.         next if (/^#/);
  1487.         if (/^([^*]\S+)\s+(\S+)/) {
  1488.         printf("Found link $1 -> $2\n") if ($debug);
  1489.         $links{$1} = $2;
  1490.         }
  1491.     }
  1492.     close(RM);
  1493.     }
  1494. name:
  1495.     foreach $i (@names) {
  1496.     if (-e $i) {
  1497.         printf("$i still exists, deleting it\n");
  1498.         if (!unlink("$i")) {
  1499.         printf("Delete failed: $!\n");
  1500.         $status = 1;
  1501.         next name;
  1502.         }
  1503.     }
  1504.     if (defined($links{$i})) {
  1505.         printf("Putting $i on delete list\n") if ($debug);
  1506.         push(@delete, $i);
  1507.     } else {
  1508.         system("cvs -d $cvsroot $cvsCmdArgs remove $i");
  1509.     }
  1510.     }
  1511.     if ($#delete >= $[) {
  1512.     if (!open(RM1, "SCVS/$linkFile")) {
  1513.         printf("Can't open SCVS/$linkFile: $!\n");
  1514.         $status = 1;
  1515.         next name;
  1516.     }
  1517.     if (!open(RM2, ">$tmpfile")) {
  1518.         printf("Can't open $tmpfile: $!\n");
  1519.         $status = 1;
  1520.         next name;
  1521.     }
  1522. line:
  1523.     while (<RM1>) {
  1524.         if (/^([^#*]\S+)\s+(\S+)/) {
  1525.         for ($i = 0; $i <= $#delete; $i++) {
  1526.             if ($delete[$i] eq $1) {
  1527.             splice(@delete, $i, 1);
  1528.             print RM2 "*$_";
  1529.             next line;
  1530.             }
  1531.         }
  1532.         }
  1533.         print RM2 $_;
  1534.     }
  1535.     close(RM1);
  1536.     close(RM2);
  1537.     if (!rename("$tmpfile", "SCVS/$linkFile")) {
  1538.         printf("Rename of $tmpfile to SCVS/$linkFile failed:$!\n");
  1539.         unlink("$tmpfile");
  1540.         $status = 1;
  1541.     }
  1542.     }
  1543.     return $status;
  1544. }
  1545. #
  1546. # Info($path)
  1547. #
  1548. # Prints out status information for the current directory and recurses
  1549. # on subdirectories.
  1550. #
  1551. # Results: 0 if successful, 1 otherwise
  1552. #
  1553. # Side effects: 
  1554. #
  1555. sub Info {
  1556.     local($path) = shift;
  1557.     local($tail);
  1558.     local($diff) = 0;
  1559.     local($cat) = 0;
  1560.     local($i);
  1561.     local($pwd) = $ENV{'PWD'};
  1562.  
  1563.     if (!-d "CVS.adm") {
  1564.     return 0;
  1565.     }
  1566.     $tail = substr($path, rindex($path, '/') + 1);
  1567.     if ($tail eq "SCVS") {
  1568.     return 0;
  1569.     }
  1570.     system("cvs -d $cvsroot $cvsCmdArgs info ");
  1571.     if (-d "SCVS") {
  1572.     &Chdir("SCVS") == 0 || return 1;
  1573.     open(INFO, "cvs -d $cvsroot $cvsCmdArgs info |") ||
  1574.         return &Error(1, "Can't do cvs info on $path: $!\n");
  1575.     while(<INFO>) {
  1576.         if (/^[UMC]\s+$linkFile/) {
  1577.         $diff = 1;
  1578.         last;
  1579.         } elsif (/^[AD]\s+$linkFile/) {
  1580.         $cat = 1;
  1581.         last;
  1582.         }
  1583.     }
  1584.     close(INFO);
  1585.     if ($diff) {
  1586.         local(%updated);
  1587.         open(INFO, "cvs -d $cvsroot diff $linkFile |") ||
  1588.         return &Error(1, "Can't do cvs diff on $path/$linkFile: $!\n");
  1589.         while(<INFO>) {
  1590.         if (/^>\s+([^*]\S+)/) {
  1591.             printf("A %s\@\n", $1);
  1592.         } elsif (/^>\s+[*](\S+)/) {
  1593.             printf("R %s\@\n", $1);
  1594.             delete $updated{$1};
  1595.         } elsif (/^<\s+([^*]\S+)/) {
  1596.             $updated{$1} = 1;
  1597.         } elsif (/^<\s+[*](\S+)/) {
  1598.             printf("D %s\@\n", $1);
  1599.         }
  1600.         }
  1601.         close(INFO);
  1602.         foreach $i (keys %updated) {
  1603.         printf("U %s\@\n", $i);
  1604.         }
  1605.     }
  1606.     if ($cat) {
  1607.         open(INFO, "$linkFile") ||
  1608.         return &Error(1, "Open of $linkFile failed: $!\n");
  1609.         while(<INFO>) {
  1610.         next if (/^#/);
  1611.         if (/^([^*]\S+)/) {
  1612.             printf("A %s\@\n", $1);
  1613.         } elsif (/^([*]\S+)/) {
  1614.             printf("R %s\@\n", $1);
  1615.         }
  1616.         }
  1617.         close(INFO);
  1618.     }
  1619.     &Chdir($pwd) == 0 || return 1;
  1620.     }
  1621.     if (($recurse) && ($#files < $[)) {
  1622.     $status = &AllSubdirs($path, "Info");
  1623.     }
  1624. }
  1625.  
  1626. #
  1627. # InfoCmd(@modules)
  1628. #
  1629. # Prints out status information for the given modules.
  1630. #
  1631. # Results: 0 if successful, 1 otherwise
  1632. #
  1633. # Side effects: 
  1634. #
  1635.  
  1636. sub InfoCmd {
  1637.     local(@modules) = @_;
  1638.     local($pwd, $i);
  1639.     local($status) = 0;
  1640.     local(@options) = ("l", $OPT_FALSE, *recurse, "Don't recurse on subdirs");
  1641.     local(@targs);
  1642.  
  1643.     $recurse = 1;
  1644.     undef($cvsargs);
  1645.     &Opt_Parse(*modules, @options, $OPT_OPTIONS_FIRST);
  1646.     print "@modules\n" if ($debug);
  1647.  
  1648.     if ($#modules < $[) {
  1649.     push(@modules, ".");
  1650.     }
  1651.     if (-e "SCVS/$argFile") {
  1652.     @targs = &ReadFile("SCVS/$argFile", 1);
  1653.     if ($targs[1] =~ /(.*)-p(.*)/) {
  1654.         $targs[1] = "$1 $2";
  1655.     }
  1656.     chop($targs[0]);
  1657.     $cvsCmdArgs .= $targs[0];
  1658.     }
  1659.     if (! -d $modules[0]) {
  1660.     $status = &Lock("r","."); 
  1661.     if ($status) {
  1662.         return $status;
  1663.     }
  1664.     system("cvs -d $cvsroot $cvsCmdArgs info @modules");
  1665.     } else {
  1666.     $status = &Lock("r",@modules);
  1667.     if ($status) {
  1668.         return $status;
  1669.     }
  1670.     $pwd = $ENV{'PWD'};
  1671.     foreach $i (@modules) {
  1672.         printf("InfoCmd %i\n") if ($debug);
  1673.         &Chdir($i) == 0 || return 1; 
  1674.         $status = &Info($i);
  1675.         if ($status) {
  1676.         return $status;
  1677.         }
  1678.         &Chdir($pwd) == 0 || return 1; 
  1679.     }
  1680.     }
  1681.     return $status;
  1682. }
  1683.  
  1684. #
  1685. # DiffFile($path, $file, $args, $current)
  1686. #
  1687. # Prints out status information for the current directory and recurses
  1688. # on subdirectories.
  1689. #
  1690. # Results: 0 if successful, 1 otherwise
  1691. #
  1692. # Side effects: 
  1693. #
  1694. sub DiffFile {
  1695.     local($path) = shift;    # Current path.
  1696.     local($file) = shift;    # File to diff.
  1697.     local($args) = shift;    # args to cvs diff.
  1698.     local($current) = shift;    # Should we diff with current version.
  1699.     local($tail);
  1700.     local($pwd) = $ENV{'PWD'};
  1701.     local($status) = 0;
  1702.     local($version) = "";
  1703.     local($repository);
  1704.  
  1705.     if (!-d "CVS.adm") {
  1706.     return 0;
  1707.     }
  1708.     $repository = &Repository(".");
  1709.     if (!defined($repository)) {
  1710.     print("Repository not found\n") if ($debug);
  1711.     return 0;
  1712.     }
  1713.     printf("Repository is $repository\n") if ($debug);
  1714.     if (!-e "$repository/$file,v") {
  1715.     return 0;
  1716.     }
  1717.     if ($current) {
  1718.     open(DIFF, "cvs -d $cvsroot status $file |") ||
  1719.         return &Error(1, "Can't get status for $path/$file: $!\n");
  1720.     while(<DIFF>) {
  1721.         if (/^RCS:\s+(\S+)/) {
  1722.         $version = "-r $1";
  1723.         last;
  1724.         }
  1725.     }
  1726.     close(DIFF);
  1727.     }
  1728.     system("cvs -d $cvsroot $cvsCmdArgs diff $version $args $file");
  1729. }
  1730.  
  1731. #
  1732. # Diff($path, $args, $current)
  1733. #
  1734. # Prints out status information for the current directory and recurses
  1735. # on subdirectories.
  1736. #
  1737. # Results: 0 if successful, 1 otherwise
  1738. #
  1739. # Side effects: 
  1740. #
  1741. sub Diff {
  1742.     local($path) = shift;    # Current path.
  1743.     local($args) = shift;    # args to cvs diff.
  1744.     local($current) = shift;    # Should we diff with current version.
  1745.     local($tail);
  1746.     local($pwd) = $ENV{'PWD'};
  1747.     local($file);
  1748.     local($status) = 0;
  1749.  
  1750.     if (!-d "CVS.adm") {
  1751.     return 0;
  1752.     }
  1753.     $tail = substr($path, rindex($path, '/') + 1);
  1754.     if ($tail eq "SCVS") {
  1755.     return 0;
  1756.     }
  1757.     opendir(THISDIR, ".") || return &Error(1, "Opendir of $path failed: $!\n");
  1758.     foreach $file (grep(-f, readdir(THISDIR))) {
  1759.     printf(STDERR "$file\n") if ($debug);
  1760.     $status = &DiffFile($path, $file, $args, $current);
  1761.     if ($status) {
  1762.         return $status;
  1763.     }
  1764.     }
  1765.     if ($recurse) {
  1766.     $status = &AllSubdirs($path, "Diff", $args, $current);
  1767.     }
  1768. }
  1769.  
  1770.  
  1771.  
  1772. #
  1773. # DiffCmd(@modules)
  1774. #
  1775. # Does an rcsdiff on the modules or directories
  1776. #
  1777. # Results: 0 if successful, 1 otherwise
  1778. #
  1779. # Side effects: 
  1780. #
  1781.  
  1782. sub DiffCmd {
  1783.     local(@modules) = @_;
  1784.     local($pwd, $i);
  1785.     local($status) = 0;
  1786.     local($current) = 0;
  1787.     local(@options) = (
  1788.     "R", $OPT_TRUE, *current, "Diff with current version",
  1789.     "l", $OPT_FALSE, *recurse, "Recurse on subdirectories",
  1790.     "b", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1791.     "i", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1792.     "w", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1793.     "t", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1794.     "c", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1795.     "e", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1796.     "f", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1797.     "h", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1798.     "n", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1799.     "r", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  1800.     );
  1801.  
  1802.     $recurse = 1;
  1803.     undef($cvsargs);
  1804.     &Opt_Parse(*modules, @options, $OPT_OPTIONS_FIRST | $OPT_NO_SPACE);
  1805.     print "@modules\n" if ($debug);
  1806.     if ($#modules < $[) {
  1807.     push(@modules, ".");
  1808.     }
  1809.     if (! -d $modules[0]) {
  1810.     $status = &Lock("r","."); 
  1811.     if ($status) {
  1812.         return $status;
  1813.     }
  1814.     foreach $i (@modules) {
  1815.         &DiffFile(".", $i, $cvsargs, $current);
  1816.     }
  1817.     } else {
  1818.     $status = &Lock("r",@modules);
  1819.     if ($status) {
  1820.         return $status;
  1821.     }
  1822.     $pwd = $ENV{'PWD'};
  1823.  
  1824.     foreach $i (@modules) {
  1825.         printf("DiffCmd $i\n") if ($debug);
  1826.         &Chdir($i) == 0 || return 1; 
  1827.         $status = &Diff($i, $cvsargs, $current);
  1828.         if ($status) {
  1829.         return $status;
  1830.         }
  1831.         &Chdir($pwd) == 0 || return 1; 
  1832.     }
  1833.     }
  1834.     return $status;
  1835. }
  1836.  
  1837. #
  1838. # Cvs($path, $command)
  1839. #
  1840. # Run a cvs command in the current directory and its subdirectories.
  1841. # Any output from the command is printed.  The command is not executed
  1842. # in any "SCVS" subdirectories.
  1843. #
  1844. # Results: 0 if successful, 1 otherwise
  1845. #
  1846. # Side effects: 
  1847. #
  1848. sub Cvs {
  1849.     local($path) = shift;
  1850.     local($command) = shift;
  1851.     local($pwd) = $ENV{'PWD'};
  1852.     local($status) = 0;
  1853.     local($output, $tail);
  1854.  
  1855.     if (!-d "CVS.adm") {
  1856.     return 0;
  1857.     }
  1858.     $tail = substr($path, rindex($path, '/') + 1);
  1859.     if ($tail eq "SCVS") {
  1860.     return 0;
  1861.     }
  1862.     printf("%s\n", $path);
  1863.     system("cvs -d $cvsroot $cvsCmdArgs $command");
  1864.     if ($recurse) {
  1865.     $status = &AllSubdirs($path, "Cvs", $command);
  1866.     }
  1867.     return $status;
  1868. }
  1869.  
  1870.  
  1871. #
  1872. # CvsCmd($command, @modules)
  1873. #
  1874. # Runs a cvs command on each module and its subdirectories.
  1875. # Any output from the command is printed.
  1876. #
  1877. # Results: 0 if successful, 1 otherwise
  1878. #
  1879. # Side effects: 
  1880. #
  1881.  
  1882. sub CvsCmd {
  1883.     local($command) = shift;
  1884.     local(@modules) = @_;
  1885.     local($i, @args);
  1886.     local($status) = 0;
  1887.     local($path);
  1888.     local($pwd) = $ENV{'PWD'};
  1889.     local(@options) = (
  1890.     "l", $OPT_FALSE, *recurse, "Don't recurse on subdirs",
  1891.     "L", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1892.     "R", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1893.     "h", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1894.     "t", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1895.     "b", $OPT_FUNC, "CvsOpt1", $OPT_NULL,
  1896.     "d", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  1897.     "l", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  1898.     "r", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  1899.     "s", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  1900.     "w", $OPT_FUNC, "CvsOpt2", $OPT_NULL,
  1901.     );
  1902.  
  1903.  
  1904.     $recurse = 1;
  1905.     undef($cvsargs);
  1906.     &Opt_Parse(*modules, @options, $OPT_OPTIONS_FIRST | $OPT_NO_SPACE);
  1907.  
  1908.     if ($#modules < $[) {
  1909.     push(@modules, ".");
  1910.     }
  1911.     if (! -d $modules[0]) {
  1912.     $status = &Lock("r","."); 
  1913.     if ($status) {
  1914.         return $status;
  1915.     }
  1916.     $tmp = "cvs -d $cvsroot $cvsCmdArgs $command $cvsargs @modules";
  1917.     print "$tmp\n" if ($debug);
  1918.     system($tmp);
  1919.     } else {
  1920.     $status = &Lock("r", @modules); 
  1921.     if ($status) {
  1922.         return $status;
  1923.     }
  1924. module: 
  1925.     foreach $i (@modules) {
  1926.         &Chdir($i) == 0 || return 1; 
  1927.         $status = &Cvs($i, $command);
  1928.         &Chdir($pwd) == 0 || return 1; 
  1929.     }
  1930.     }
  1931.     return $status;
  1932. }
  1933.  
  1934.  
  1935.  
  1936. #
  1937. # Exit
  1938. #
  1939. # Exit with a status of 1.
  1940. #
  1941. # Results: Doesn't return
  1942. #
  1943. # Side effects: The script exits.
  1944. #
  1945.  
  1946.  
  1947. sub Exit {
  1948.     exit(1);
  1949. }
  1950.  
  1951.  
  1952. #
  1953. # Usage(@optionArray)
  1954. #
  1955. # Print out help information.
  1956. #
  1957. # Results: None
  1958. #
  1959. # Side effects: Stuff is printed
  1960. #
  1961. sub Usage {
  1962.     local(@options) = @_;
  1963.     local(%info) = (("unpack", "Create symbolic links"),
  1964.             ("checkout", "Checkout a copy of a module"),
  1965.             ("unlock", "Unlock a module"),
  1966.             ("lock", "Lock a module"),
  1967.             ("update", "Update a copy of a module"),
  1968.             ("done", "User is done with a module"),
  1969.             ("commit", "Commit changes to a module"),
  1970.             ("who", "Print a list of users with copies of a module"),
  1971.             ("diff", "Do rcsdiff on files you have changed"),
  1972.             ("status", "Print out rcs status of files"),
  1973.             ("log", "Print rcs log of files"),
  1974.             ("join", "Merge in new vendor release"),
  1975.             ("patch", "Create a patch file"),
  1976.             ("tag", "Tag a version"));
  1977.  
  1978.     &Opt_PrintUsage(@options);
  1979.     printf("\nValid commands are:\n");
  1980.     foreach $i sort ("unpack", "checkout", "unlock", "lock", "update", 
  1981.             "done", "commit", "who", "diff", "status", "log",
  1982.             @cvsCmds) {
  1983.     printf("\t$i\t%s\n", $info{$i});
  1984.     }
  1985. }
  1986.  
  1987. #
  1988. # Error($status, @args)
  1989. #
  1990. # Prints @args to STDERR, and returns $status
  1991. #
  1992. # Results: $status
  1993. #
  1994. # Side effects: Stuff is printed
  1995. #
  1996. sub Error {
  1997.     local($status) = shift;
  1998.     if ($#_ >= $[) {
  1999.     printf(STDERR @_);
  2000.     }
  2001.     return $status;
  2002. }
  2003.  
  2004. #
  2005. # ReadFile($file, $ignoreComments)
  2006. #
  2007. # Reads the contents of the given file.  If $ignoreComments is non-zero
  2008. # then any line beginning with '#' is ignored.  
  2009. #
  2010. # Results: An array containing each line of the file.  If a scalar is
  2011. #     wanted then only the first line is returned.
  2012. #
  2013. # Side effects: 
  2014. #
  2015. sub ReadFile {
  2016.     local($file) = shift;
  2017.     local($ignoreComments) = shift; 
  2018.     local(@contents);
  2019.     open(READ, "$file") ||
  2020.     return &Error(undef, "Open of $file failed: $!\n");
  2021.     if ($ignoreComments) {
  2022.     @contents = grep(!/^#/, <READ>);
  2023.     } else {
  2024.     @contents = <READ>;
  2025.     }
  2026.     close(READ);
  2027.     if ($#contents < $[) {
  2028.     return undef;
  2029.     }
  2030.     if (wantarray) {
  2031.     return @contents;
  2032.     } 
  2033.     return($contents[0]);
  2034. }
  2035.  
  2036. #
  2037. # WriteFile($file, @args)
  2038. #
  2039. # Writes @args to $file.  The file is created if it doesn't exist.
  2040. #
  2041. # Results: 0 if successful, 1 otherwise
  2042. #
  2043. # Side effects:  $file may be created, and it is written.
  2044. #
  2045. sub WriteFile {
  2046.     local($file) = shift;
  2047.     open(WRITE, ">$file") ||
  2048.     return &Error(1, "Open of $file failed: $!\n");
  2049.     print WRITE @_;
  2050.     close(WRITE);
  2051.     return 0;
  2052. }
  2053.  
  2054.  
  2055. #
  2056. # GetModuleName
  2057. #
  2058. # Gets the module name from the name in CVS.adm/Repository and %dirMap.
  2059. #
  2060. # Results: The module name.
  2061. #
  2062. # Side effects:  
  2063. #
  2064. sub GetModuleName {
  2065.     local($dir);
  2066.     local($index);
  2067.     if (!defined(%dirMap)) {
  2068.     &ModMap;
  2069.     }
  2070.     $dir = &ReadFile("CVS.adm/Repository");
  2071.     chop($dir);
  2072.     printf("$dir\n") if ($debug);
  2073.     if (!defined($dir)) {
  2074.     return undef;
  2075.     }
  2076.     while($dir ne "") {
  2077.     if (defined($dirMap{$dir})) {
  2078.         printf("Module $dirMap{$dir}\n") if ($debug);
  2079.         return $dirMap{$dir};
  2080.     }
  2081.     $index = rindex($dir, '/');
  2082.     if ($index < $[) {
  2083.         last;
  2084.         return $dir;
  2085.     }
  2086.     $dir = substr($dir, 0, $index);
  2087.     }
  2088.     return $dir;
  2089. }
  2090.  
  2091.  
  2092. #
  2093. # Chdir($dir)
  2094. #
  2095. # Changes the current working directory to $dir.  If the command fails
  2096. # an error message is printed. 
  2097. #
  2098. # Results: 0 if successful, 1 otherwise
  2099. #
  2100. # Side effects:  The current working directory is changed, and $ENV{'PWD'}
  2101. #     set to the new working directory.
  2102. #
  2103. sub Chdir {
  2104.     &chdir($_[0]) ||
  2105.     return &Error(1, "Chdir to %s from %s failed: $!\n", 
  2106.         $_[0], $ENV{'PWD'});
  2107.     return 0;
  2108. }
  2109.  
  2110. #
  2111. # ModMap
  2112. #
  2113. # Creates a mapping of module name to its subdirectory in the repository,
  2114. # and a mapping from the subdirectory to the module name.
  2115. #
  2116. # Results: 0 if successful, 1 otherwise
  2117. #
  2118. # Side effects:  The %modMap and %dirMap are filled in.
  2119. #
  2120.  
  2121. sub ModMap {
  2122.     local($module, $dir);
  2123.     open(MOD, "cvs -d $cvsroot co -c |") ||
  2124.     return &Error(1, "Can't do \"cvs co -c\"\n");
  2125.     undef %modMap;
  2126.     while(<MOD>) {
  2127.     if (/^(\S+)\s+(\S+)/) {
  2128.         $modMap{$1} = $2;
  2129.         $dirMap{$2} = $1;
  2130.     }
  2131.     }
  2132.     close(MOD);
  2133. }
  2134.  
  2135. #
  2136. # Main
  2137. #
  2138. #
  2139. $SIG{'INT'} = Exit;
  2140. &initpwd;
  2141. $tmpfile = "#SCVS.$$";
  2142. $status = 0;
  2143. if (&Config) {
  2144.     exit(1);
  2145. }
  2146. $command = shift;
  2147. if (!defined($command)) {
  2148.     &Usage(@options);
  2149.     exit(1);
  2150. }
  2151. printf("$command: %s\n", join(' ', @ARGV)) if ($debug);
  2152.  
  2153. if (($command eq "pack") || ($command eq "unpack")) {
  2154.     local(@options) = ("l", $OPT_FALSE, *recurse, "Recurse on subdirectories");
  2155.     &Opt_Parse(*ARGV, @options, 0);
  2156.     $status = &PackCmd($command, @ARGV);
  2157. } elsif (($command eq "checkout") || ($command eq "co")) {
  2158.     $command = "checkout";
  2159.     $status = &Checkout(@ARGV);
  2160. } elsif ($command eq "unlock") {
  2161.     $status = &UnlockCmd(@ARGV);
  2162. } elsif ($command eq "lock") {
  2163.     $status = &LockCmd(@ARGV);
  2164.     undef(@locks);
  2165. } elsif ($command eq "update") {
  2166.     $status = &UpdateCmd(1, @ARGV);
  2167. } elsif ($command eq "done") {
  2168.     $status = &DoneCmd(@ARGV);
  2169. } elsif (($command eq "commit") || ($command eq "ci")) {
  2170.     $status = &CommitCmd(@ARGV);
  2171. } elsif ($command eq "who") {
  2172.     $status = &WhoCmd(@ARGV);
  2173. } elsif ($command eq "add") {
  2174.     $status = &AddCmd(@ARGV);
  2175. } elsif ($command eq "remove") {
  2176.     $status = &RemoveCmd(@ARGV);
  2177. } elsif ($command eq "info") {
  2178.     $status = &InfoCmd(@ARGV);
  2179. } elsif ($command eq "diff") {
  2180.     $status = &DiffCmd(@ARGV);
  2181. } elsif (($command eq "status") || ($command eq "log")) {
  2182.     $status = &CvsCmd($command, @ARGV);
  2183. } elsif (grep($command eq $_, @cvsCmds)) {
  2184.     system("cvs -d $cvsroot $cvsCmdArgs $command @ARGV");
  2185.     $status = 0;
  2186. } else {
  2187.     printf("Bad command: $command\n");
  2188.     &Usage(@options);
  2189.     exit(1);
  2190. }
  2191.  
  2192. # Unlock any modules we may have locked.
  2193.  
  2194. if ($#locks >= $[) {
  2195.     &Unlock(0, @locks);
  2196. }
  2197. if ($status) {
  2198.     printf("$command failed\n");
  2199. }
  2200. exit($status);
  2201.